Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mquery / mprofile.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-05-02 | 11.2 KB | 396 lines

VERSION 2.00 Begin Form fStoreQry BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "Stored Query Manager" ClientHeight = 3960 ClientLeft = 1290 ClientTop = 2685 ClientWidth = 4980 ClipControls = 0 'False ControlBox = 0 'False Height = 4365 Left = 1230 LinkMode = 1 'Source LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3960 ScaleWidth = 4980 Top = 2340 Width = 5100 Begin OptionButton OpSQLUser BackColor = &H00C0C0C0& Caption = "Public:" Height = 240 Index = 1 Left = 465 TabIndex = 7 Top = 2250 Width = 885 End Begin OptionButton OpSQLUser BackColor = &H00C0C0C0& Caption = "Private:" Height = 240 Index = 0 Left = 465 TabIndex = 13 Top = 1950 Value = -1 'True Width = 915 End Begin CommandButton DeleteBtn Cancel = -1 'True Caption = "&Delete" Height = 375 Left = 3735 TabIndex = 12 Top = 3060 Width = 1035 End Begin SSPanel msgpanel Align = 2 'Align Bottom BackColor = &H00C0C0C0& BevelInner = 1 'Inset Font3D = 0 'None ForeColor = &H00FF0000& Height = 420 Left = 0 TabIndex = 6 Top = 3540 Width = 4980 End Begin ListBox cqueries BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 1005 Left = 570 Sorted = -1 'True TabIndex = 11 TabStop = 0 'False Top = 390 Width = 3855 End Begin CommandButton BtnQuit Caption = "&Quit" Height = 375 Left = 2520 TabIndex = 5 Top = 3060 Width = 1035 End Begin CommandButton BtnRead Caption = "&Load" Height = 375 Left = 1305 TabIndex = 4 Top = 3060 Width = 1035 End Begin CommandButton BtnWrite Caption = "&Save" Height = 375 Left = 120 TabIndex = 3 Top = 3060 Width = 1035 End Begin TextBox TxtKey BackColor = &H00C0C0C0& Height = 375 Left = 1500 TabIndex = 2 Top = 2520 Width = 2895 End Begin TextBox TxtSection BackColor = &H00C0C0C0& Height = 375 Left = 1500 TabIndex = 1 TabStop = 0 'False Top = 2040 Width = 2895 End Begin TextBox TxtINIFile BackColor = &H00C0C0C0& Enabled = 0 'False Height = 375 Left = 1500 TabIndex = 0 TabStop = 0 'False Top = 1560 Width = 2895 End Begin Label lblQueries Alignment = 2 'Center AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Select Query" Height = 195 Left = 540 TabIndex = 9 Top = 210 Width = 1125 End Begin Label LblKey Alignment = 1 'Right Justify AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Query Name:" Height = 195 Left = 285 TabIndex = 8 Top = 2640 Width = 1110 End Begin Label LblINIFile Alignment = 1 'Right Justify AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Storage:" Height = 195 Left = 690 TabIndex = 10 Top = 1620 Width = 735 End Dim FwriteFlag As Integer ' did I write Dim Fdelstr As String Dim FSection As String Dim fDefaultuser As String Sub BtnQuit_Click () ' written or quit If FwriteFlag Then ' stored query FwriteFlag = False End If gstDynaString = "" ' was this a stored query that was run If Not gStoredFlag Then 'not from storage fQuery!RunSaveQryButton.Enabled = True fQuery!RunQueryButton.Enabled = False If gfFROMSQL Then ' was a SQL Statement? fQuery!RunQueryButton.Enabled = False End If fQuery!RunSaveQryButton.Enabled = True End If Unload Me End Sub Sub BtnRead_Click () If TxtINIFile.Text = "" Then Beep TxtINIFile.SetFocus Exit Sub End If If TxtSection.Text = "" Then Beep TxtSection.SetFocus Exit Sub End If If Txtkey.Text = "" Then Beep Txtkey.SetFocus Exit Sub End If 'Assign textbox contents to variables for API call. '(API call won't take references to Textbox contents.) Sectn$ = TxtSection.Text Keyy$ = Txtkey.Text DeeFalt$ = "" FileNam$ = gWindowsDirectory + "\" + TxtINIFile.Text gstDynaString = StringfromPrivINI(Sectn$, Keyy$, DeeFalt$, FileNam$) If gstDynaString = "" Then msgpanel.Caption = "Section, Key or File name not found." Else fQuery!RunSaveQryButton.Enabled = False DeleteBtn.Enabled = True Unload Me End If End Sub Sub BtnWrite_Click () FwriteFlag = False DeleteBtn.Enabled = False If TxtSection.Text = "" Then Beep TxtSection.SetFocus Exit Sub End If If Txtkey.Text = "" Then Beep Txtkey.SetFocus Exit Sub End If ' clear out GstDynaString if it has carriage return and linefeeds ' pasted or otherwise inserted a% = 0 For y% = 1 To Len(gstDynaString) - 2 a% = InStr(y% + a%, gstDynaString, Chr(13) + Chr(10)) If a% Then gstDynaString = Left(gstDynaString, a% - 1) + " " + Mid(gstDynaString, a% + 2, Len(gstDynaString)) End If Next y% Sectn$ = TxtSection.Text Keyy$ = Txtkey.Text Valyue$ = gstDynaString FileNam$ = gWindowsDirectory + "\" + TxtINIFile.Text Result% = StringtoPrivINI(Sectn$, Keyy$, Valyue$, FileNam$) If Result% = 0 Then msgpanel.Caption = "QUERY NOT SAVED." Else msgpanel.Caption = "QUERY SAVED." FwriteFlag = True End If gstDynaString = "" End Sub Sub cqueries_Click () If gstDynaString = "" Then Txtkey.Text = cqueries.List(cqueries.ListIndex) BtnRead.Enabled = True DeleteBtn.Enabled = True msgpanel.Caption = "QUERY SELECTED ...LOAD OR DELETE OR QUIT." End If End Sub Sub cqueries_KeyPress (keyascii As Integer) keyascii = 0 End Sub Sub DeleteBtn_Click () Fdelstr = Txtkey.Text If MsgBox("Delete " & Fdelstr & " ?", MSGBOX_TYPE) = YES Then delquery Unload Me End If End Sub Sub delquery () Dim f As String Dim h As String Dim a As Integer Dim b As Integer Dim filein As String Dim fileout As String On Error GoTo errorhere a = InStr(1, TxtINIFile.Text, ".") filein = gWindowsDirectory + "\" + TxtINIFile.Text fileout = gWindowsDirectory + "\" + Left(TxtINIFile, a) + "bak" h = FSection Open filein For Input As 1 Open fileout For Output As 2 h = Fdelstr a = 0 Do Until a > 0 Line Input #1, f a = InStr(1, f, FSection) Print #2, f Do Until EOF(1) Line Input #1, f a = InStr(1, f, h) b = InStr(1, f, "[") If b = 1 Then ' found new section Print #2, f h = "XXXXXX" Else If a = 0 Then Print #2, f End If End If closeem: Close 1 Close 2 Kill filein Name fileout As filein MsgBox Fdelstr & " Deleted", 48 Exit Sub errorhere: MsgBox "Error " & Str(Err), 48 Resume closeem End Sub Sub Form_Load () fStoreQry.Left = (Screen.Width - fStoreQry.Width) / 2 fStoreQry.Top = (Screen.Height - fStoreQry.Height) / 2 '******************************************************* '* FDefaultuser can be the user ID from a network * '* Then sections can be PUBLIC for all users and * '* Private for the individual. This way someone * '* who has a particular query for the database * '* can share it with others. * '******************************************************* gWindowsDirectory = WinDir() fDefaultuser = "SMYTHERE" ' from network ID if MU gSQLUser = fDefaultuser getsections BtnWrite.Enabled = False BtnRead.Enabled = False DeleteBtn.Enabled = False If gstDynaString <> "" Then Txtkey.Text = "" BtnWrite.Enabled = True DeleteBtn.Enabled = False msgpanel.Caption = "Enter a Query Name then SAVE or QUIT" End If End Sub Sub getsections () Dim a As Integer Dim b As Integer Dim f As String Dim filein As String FSection = gSQLUser TxtSection.Text = FSection TxtINIFile.Text = "STOREQRY.INI" filein = TxtINIFile.Text On Error GoTo nofile Open gWindowsDirectory + "\" + TxtINIFile.Text For Input As 1 Line Input #1, f a = InStr(1, f, "[" + FSection + "]") Loop Until a > 0 ' check to see why loop ended If a Then ' found the section Do ' loop until no more keys If EOF(1) Then Close 1 Exit Sub End If Line Input #1, f ' read next line a = InStr(1, f, "=") ' if true then we have a key and value If a = 0 Then Close 1 Exit Sub End If b = InStr(1, f, "=") ' true so parse it cqueries.AddItem Left(f, b - 1) 'add query name to combo box Loop Else ' this database not here MsgBox gstDBname + " Not Found" Close 1 Exit Sub End If getout: Close 1 Exit Sub nofile: If Err = 62 Then Resume getout MsgBox "error = " + Str(Err) Resume getout End If End Sub Sub opSQLUser_Click (Index As Integer) SQLUserSelect (Index) cqueries.Clear getsections' Form_Load End Sub Sub SQLUserSelect (I As Integer) If I = 0 Then gSQLUser = fDefaultuser gSQLUser = "PUBLIC" End If End Sub Sub TxtKey_KeyPress (keyascii As Integer) If gstDynaString = "" Then keyascii = 0 End If End Sub